home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / compiler / emit_phr.ml < prev    next >
Encoding:
Text File  |  1993-09-24  |  1.5 KB  |  60 lines  |  [TEXT/MPS ]
  1. (* Emitting phrases *)
  2.  
  3. #open "instruct";;
  4. #open "buffcode";;
  5. #open "emitcode";;
  6.  
  7. type compiled_phrase =
  8.   { cph_pos: int;                       (* Position of start of code *)
  9.     cph_len: int;                       (* Length of code *)
  10.     cph_reloc: (reloc__info * int) list;(* What to patch *)
  11.     cph_pure: bool }                    (* Can be omitted or not *)
  12. ;;
  13.  
  14. let abs_out_position = ref 0
  15. ;;
  16. let compiled_phrase_index = ref ([] : compiled_phrase list)
  17. ;;
  18.  
  19. let start_emit_phrase outchan =
  20.   output_binary_int outchan 0;
  21.   abs_out_position := 4;
  22.   compiled_phrase_index := []
  23. ;;
  24.  
  25. let emit_phrase outchan is_pure phr =
  26.   reloc__reset();
  27.   init_out_code();
  28.   labels__reset_label_table();
  29.   begin match phr with
  30.     { kph_fcts = [] } ->
  31.         emit phr.kph_init
  32.   | { kph_rec = false } ->
  33.         emit [Kbranch 0];
  34.         emit phr.kph_fcts;
  35.         emit [Klabel 0];
  36.         emit phr.kph_init
  37.   | { kph_rec = true } ->
  38.         emit phr.kph_init;
  39.         emit [Kbranch 0];
  40.         emit phr.kph_fcts;
  41.         emit [Klabel 0]
  42.   end;
  43.   output outchan !out_buffer 0 !out_position;
  44.   compiled_phrase_index :=
  45.     { cph_pos = !abs_out_position;
  46.       cph_len = !out_position;
  47.       cph_reloc = reloc__get_info();
  48.       cph_pure = is_pure } :: !compiled_phrase_index;
  49.   abs_out_position := !abs_out_position + !out_position
  50. ;;
  51.  
  52. let end_emit_phrase outchan =
  53.   output_value outchan !compiled_phrase_index;
  54.   compiled_phrase_index := [];
  55.   seek_out outchan 0;
  56.   output_binary_int outchan !abs_out_position
  57. ;;
  58.  
  59.  
  60.